home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / wgsave11.zip / SCRNSAV1.PAS next >
Pascal/Delphi Source File  |  1993-07-13  |  9KB  |  252 lines
  1. {$A+,B-,D+,E+,F+,G-,I+,L+,N-,O-,R+,S+,V+,X-}
  2. {$M 8192,0,655360}
  3.  
  4. {File : SCRNSAV1.PAS, Vs. 1.1, for TP 7.0.
  5.  
  6.  Test of screen saver.
  7.  This is only a simple example, don't expect too much.
  8.  Look for all lines with +++ comment.
  9.  
  10.  The GetEvent and Idle method of TApplication need changes.
  11.  
  12.  This program disables TV GetEvent while in screen saver mode,
  13.  (but see SCRNSAV2.PAS). Screen saver mode is canceled by pressing
  14.  any key. Mouse moves do nothing.
  15.  
  16.  If the mechanism to invoke the screen server is ok for you, then just
  17.  put your favorite flashy wonderful screen saver into the ScreenSaver method.
  18.  
  19.  Warning: There is a call to Randomize at invocation of the screen
  20.           saver. This might interfere with other parts of your program.
  21.  
  22.  
  23.  Hacked on 30-JUN-93 by Wolfgang Gross, gross@aecds.exchi.uni-heidelberg.de
  24.  Comments by Rutger van de GeVEL, rutger@kub.nl.
  25.  
  26.  Changed: 13-JUL-93  bugs, minor improvements
  27.  
  28.  }
  29.  
  30.  
  31. program TestScreenSaver;
  32.   uses CRT,DOS,Objects,memory,Drivers,Views,Menus,Dialogs,App,gadgets,msgbox;
  33.  
  34.   const
  35.     cmAboutDialog = 101;
  36.     cmTestDialog  = 102;
  37.  
  38.     {change these constants as convenient                            +++}
  39.     ScrnSaverText : String = 'Screen saver test lurking ...' ;      {+++}
  40.     GracePeriod : longint = 5000; {ask DOS time after graceperiod}  {+++}
  41.     {time values in centiseconds                                     +++}
  42.     {Invoke screen saver after program is idle for ScrnSaverDelay centisecs.
  43.      Text stays on screen for ScnrSaverPeriod centisecs. }
  44.     ScrnSaverDelay : longint = 500;                                 {+++}
  45.     ScrnSaverPeriod: longint = 500;                                 {+++}
  46.  
  47.   type
  48.  
  49.     TMyApp = object(TApplication)
  50.       KickTime : longint; {seconds}                                 {+++}
  51.       GraceCounter : word; {ask DOS time only if > graceperiod}     {+++}
  52.  
  53.       Heap: PHeapView; Clock : PClockView;
  54.       constructor init;
  55.       procedure getevent( VAR event : TEvent ); virtual;
  56.       procedure HandleEvent(var Event: TEvent); virtual;
  57.       procedure InitMenuBar; virtual;
  58.       procedure InitStatusLine; virtual;
  59.       procedure AboutDialog;
  60.       procedure TestDialog;
  61.       procedure Idle;virtual;
  62.       procedure ScreenSaver;                                        {+++}
  63.     end;
  64.  
  65.  
  66. FUNCTION Time:longint;                     {+++ we need this function +++}
  67.   {Return real day time in centiseconds. One might get in trouble with
  68.    measurements spanning midnight. Smallest reliable interval: 55 msec}
  69.   VAR Hour,Minute,Second,Sec100: WORD;                               {+++}
  70.   BEGIN                                                              {+++}
  71.     GetTime(Hour,Minute,Second,Sec100);                              {+++}
  72.     Time:=longint(Sec100)+100*(longint(Second)                       {+++}
  73.           +60*(longint(Minute)+60*longint(hour)));                   {+++}
  74.   END;                                                               {+++}
  75.  
  76.  
  77. CONSTRUCTOR TMyApp.Init;
  78.   VAR R : TRect;
  79.   BEGIN
  80.  
  81.     TApplication.Init;
  82.  
  83.     KickTime := 0; GraceCounter := 0;                                {+++}
  84.  
  85.     GetExtent(R);
  86.     R.A.X := R.B.X - 9; R.B.Y := R.A.Y + 1;
  87.     Clock := New(PClockView, Init(R));
  88.     Insert(Clock);
  89.  
  90.     GetExtent(R);
  91.     Dec(R.B.X);
  92.     R.A.X := R.B.X - 9; R.A.Y := R.B.Y - 1;
  93.     Heap := New(PHeapView, Init(R));
  94.     Insert(Heap);
  95.  
  96.   END; {PROC TMyApp.Init}
  97.  
  98.  
  99.   procedure TMyApp.GetEvent ( VAR Event : TEvent );
  100.     BEGIN
  101.       inherited GetEvent(Event);
  102.       {reset counter if events pending                         +++}
  103.       IF Event.What<>evNothing THEN                           {+++}
  104.         BEGIN GraceCounter := 0; KickTime := 0  END;          {+++}
  105.     END; {PROC TMyApp.GetEvent}
  106.  
  107.  
  108.   procedure TMyApp.HandleEvent(var Event: TEvent);
  109.  
  110.     begin {HandleEvent}
  111.  
  112.       inherited HandleEvent(Event);
  113.  
  114.       if (Event.What = evCommand) then
  115.          begin
  116.            case Event.Command of
  117.             cmAboutDialog :
  118.                AboutDialog;
  119.             cmTestDialog :
  120.                TestDialog;
  121.  
  122.             else
  123.  
  124.                Exit;
  125.            end;
  126.            ClearEvent(Event);
  127.          end
  128.  
  129.     end;  {PROC TMyApp.HandleEvent}
  130.  
  131.  
  132. PROCEDURE TMyApp.Idle;
  133.   BEGIN
  134.     inherited Idle;
  135.     Heap^.Update; Clock^.Update;
  136.  
  137.     IF GraceCounter < GracePeriod       {start calling DOS time after +++}
  138.       THEN Inc(GraceCounter)            {grace period since it's too  +++}
  139.       ELSE                              {time consuming.              +++}
  140.         BEGIN
  141.           IF KickTime=0 THEN KickTime := Time;                       {+++}
  142.           IF (Abs(Time-KickTime)>ScrnSaverDelay)                     {+++}
  143.             THEN ScreenSaver;                                        {+++}
  144.         END;
  145.  
  146.   END; {PROC TMyApp.Idle}
  147.  
  148.   procedure TMyApp.InitMenuBar;
  149.     VAR R : TRect;
  150.     begin {InitMenuBar}
  151.       GetExtent(R);
  152.       R.B.Y := R.A.Y+1;
  153.       MenuBar := New(PMenuBar, Init(R, NewMenu(
  154.         NewSubMenu('~'#240'~', 1000, NewMenu(
  155.           NewItem('~A~bout', '', kbNoKey, cmAboutDialog, 1001,nil)),
  156.         NewSubMenu('~F~ile', 1100, NewMenu(
  157.           NewItem('~T~estDialog', '', kbF3, cmTestDialog, 1010,
  158.           NewLine(
  159.           NewItem('E~x~it', '', kbAltx, cmquit, 1020,nil)))),
  160.       nil)))));
  161.     end;  {PROC TMyApp.InitMenuBar}
  162.  
  163.  
  164.   procedure TMyApp.InitStatusLine;
  165.     var   R : TRect;
  166.     begin  {InitStatusLine}
  167.       GetExtent(R);
  168.       R.A.Y := R.B.Y - 1;
  169.       StatusLine := New(PStatusLine,Init(R,
  170.         NewStatusDef(0,$FFFF,
  171.           NewStatusKey('',kbF10,cmMenu,
  172.           NewStatusKey('~Alt-X~ Exit',kbAltX,cmQuit,
  173.           NewStatusKey('~F3~ Testbox',kbF3,cmTestDialog,
  174.           nil))),
  175.         nil)
  176.       ));
  177.     end; {PROC TMyApp.InitStatusLine}
  178.  
  179.  
  180.   procedure TMyApp.AboutDialog;
  181.     var  D : PDialog;
  182.          R : TRect;
  183.          Control : PView;
  184.          C : word;
  185.     begin {AboutDialog}
  186.       R.Assign(0, 0, 40, 11);
  187.       D := New(PDialog, Init(R, 'About'));
  188.       with D^ do
  189.         begin
  190.           Options := Options or ofCentered;
  191.  
  192.           R.Grow(-1, -1);
  193.           Dec(R.B.Y, 3);
  194.           Insert(New(PStaticText, Init(R,
  195.           #13 + ^C'Turbo Vision Screen Saver Demo'#13 +
  196.           #13 + ^C'GetEvent disabled.'#13 +
  197.           #13 + ^C'W. Gross 1993'#13 )));
  198.  
  199.           R.Assign(15, 8, 25, 10);
  200.           Insert(New(PButton, Init(R, 'O~K', cmOk, bfDefault)));
  201.          end;
  202.       if ValidView(D) <> nil then
  203.         begin
  204.           c := Desktop^.ExecView(D);
  205.           Dispose(D, Done);
  206.         end;
  207.     end;  {PROC TMyApp.AboutDialog}
  208.  
  209.  
  210.   procedure TMyApp.TestDialog;
  211.     var D: PDialog;
  212.         c : word;
  213.     begin
  214.       c := messagebox ( 'This is just a dummy dialog.', nil,
  215.                         mfinformation+mfOkbutton );
  216.     end;  {PROC TMyApp.TestDialog}
  217.  
  218.  
  219.    PROCEDURE TMyApp.ScreenSaver;                                  {+++}
  220.      VAR LastTime : longint;  ch : char;                          {+++}
  221.      BEGIN                                                        {+++}
  222.        doneevents; donevideo; Randomize;                          {+++}
  223.        LastTime := 0; TextBackGround(Black);                      {+++}
  224.                                                                   {+++}
  225.          REPEAT                                                   {+++}
  226.            IF (Abs(Time-LastTime)>ScrnSaverPeriod) THEN           {+++}
  227.              BEGIN                                                {+++}
  228.                ClrScr;                                            {+++}
  229.                TextColor(Random(14)+1);                           {+++}
  230.                Gotoxy ( Random(80-length(ScrnSaverText)),         {+++}
  231.                         Random(24));                              {+++}
  232.                write ( ScrnSaverText ); LastTime := Time;         {+++}
  233.              END;                                                 {+++}
  234.          UNTIL KeyPressed;                                        {+++}
  235.                                                                   {+++}
  236.        ch := ReadKey; {eat char}                                  {+++}
  237.        KickTime := 0; GraceCounter := 0;                          {+++}
  238.        initevents; initvideo;                                     {+++}
  239.        inherited redraw;                                          {+++}
  240.                                                                   {+++}
  241.      END; {PROC TMyApp.ScreenSaver}                               {+++}
  242.  
  243.  
  244.   var
  245.     MyApp : TMyApp;
  246.  
  247.  
  248. begin {SCRNSAV1}
  249.   MyApp.Init;
  250.   MyApp.Run;
  251.   MyApp.Done;
  252. end.  {SCRNSAV1}